{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Data.Fits.KeywordRecord where

type Keyword = String
type Comment = String
type Header  = [KeywordRecord]

data KeywordRecord = CommentaryRecord CommentRecord 
                   | ValueRecord Keyword Value Comment
    deriving (Show)

data CommentRecord = HistoryKeyword         String
                   | CommentKeyword         String
                   | BLANKFIELDKeyword      String
                   | OtherKeyword           Keyword String
    deriving (Show) 

data Value = CharacterStringValue String
           | LogicalValue Bool
           | IntegerValue Integer
           | FloatingValue Double
           | ComplexIntegerValue (Integer, Integer)
           | ComplexFloatValue (Double, Double)
           | Undefined

instance Show Value where
  show (CharacterStringValue v) = concatMap (g) v where
     g x | x == '\'' = "''"
         | otherwise = [x]
  show (LogicalValue v) | v = "T"
                        | otherwise = "F"
  show (IntegerValue v) = show v
  show (FloatingValue x) = show v ++ "E" ++ show e where
     v = x / 10**(fromIntegral e)
     e = round (log (abs x) / log 10)
  show (ComplexIntegerValue (a,b)) = "(" ++ show a ++ "," ++ show b ++ ")"
  show (ComplexFloatValue (a,b)) = "(" ++ show a ++ "," ++ show b ++ ")"
  show Undefined = ""

class FitsValue a where
   toValue :: a -> Value
   fromValue :: Value -> Maybe a

instance FitsValue Integer where
  toValue = IntegerValue
  fromValue (IntegerValue v) = Just v
  fromValue _ = Nothing

instance FitsValue String where
  toValue = CharacterStringValue
  fromValue (CharacterStringValue v) = Just v
  fromValue _ = Nothing

instance FitsValue Bool where
  toValue = LogicalValue
  fromValue (LogicalValue v) = Just v
  fromValue _ = Nothing

instance FitsValue Double where
  toValue = FloatingValue
  fromValue (FloatingValue v) = Just v
  fromValue _ = Nothing

instance FitsValue (Integer, Integer) where
  toValue = ComplexIntegerValue
  fromValue (ComplexIntegerValue v) = Just v
  fromValue _ = Nothing

instance FitsValue (Double, Double) where
  toValue = ComplexFloatValue
  fromValue (ComplexFloatValue v) = Just v
  fromValue _ = Nothing


lookKeys :: Header -> String -> [Value]
lookKeys h s = do
    x <- h
    case x of 
      ValueRecord k v _ -> if k == s 
                              then [v]
                              else []
      CommentaryRecord _ -> []

lookKey :: Header -> String -> Maybe Value
lookKey h s = do
   let v = lookKeys h s
   if null v 
      then Nothing
      else return (v !! 0)

lookValue :: (FitsValue a) => Header -> String -> Maybe a
lookValue h s = lookKey h s >>= fromValue

